home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / DOORKIT2.PAS < prev    next >
Pascal/Delphi Source File  |  1997-07-14  |  34KB  |  1,032 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....
  13.  
  14.    This is the utility unit. This unit contains all of the actual useful
  15.    functions when it comes to dealing with strings and files. All system
  16.    time slicing and OS detection is handled here as well.}
  17.  
  18. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  19. UNIT DOORKIT2;
  20.  
  21. INTERFACE
  22.  
  23. USES _EXIT, DOS;
  24.  
  25. {─--[Headers]-──────────────────────────────────────────────────────────────}
  26.  
  27. PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR);
  28. {^ Just like FillChar, except you give it 2 bytes to use for the fill.
  29.    This is also a 16 Bit procedure, unlike the 8 Bit fillchar TP uses.
  30.    This is useful for filling in a text screen.}
  31. FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
  32. {^ Is file #1 older than file #2?}
  33. FUNCTION GetFileName(InString : STRING) : STRING;
  34. {^ Takes a full path and file name and returns just the file name.}
  35. FUNCTION GetFilePath(InString : STRING) : STRING;
  36. {^ Takes a full path and file name and returns just the path.}
  37. FUNCTION FSize(Fn : PathStr) : LONGINT;
  38. {^ Returns the size of the file "Fn" in bytes.}
  39. FUNCTION FErase(Fn : PathStr) : BOOLEAN;
  40. {^ Erases the file "Fn" from the hard drive.}
  41. FUNCTION FExist(Fn : PathStr) : BOOLEAN;
  42. {^ Returns true if the file "Fn" exists.}
  43. FUNCTION DExist(Fn : PathStr) : BOOLEAN;
  44. {^ Returns true if the directory "Fn" exists.}
  45. PROCEDURE MakeDir(DirName : STRING);
  46. {^ Like MkDir only checks for the directory's existence first.}
  47. FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
  48. {^ Copies SourceFile to TargetFile and returns a result code.}
  49. FUNCTION CommaInt(Number : LONGINT) : STRING;
  50. {^ Inserts commas into a number and returns a string of the number with the
  51.    commas. ie: S := Commint(1000000); S = '1,000,000' Makes Larger numbers
  52.    easier to read.}
  53. FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  54. {^ Pad the front of the string with CH, up to LEN.}
  55. FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  56. {^ Pad the end of the string with CH, up to LEN.}
  57. FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
  58. {^ Converts a number to a string with padding.
  59.    Pad = how many 0's will be padded in front of the string, to make
  60.          the number a certain length. ie: istr(45,3) = '045'}
  61. FUNCTION IntToStr(N : LONGINT) : STRING;
  62. {^ Converts a number to a string with no 0 padding.}
  63. FUNCTION StrToInt(S : STRING) : LONGINT;
  64. {^ Converts a string to a number. If the string is invalid, 0 is returned.}
  65. FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
  66. {^ Does not produce the same "TRUE" "FALSE" as Pascal, but "True" "False".}
  67. FUNCTION BoolToStr(B : BOOLEAN) : STRING;
  68. {^ Converts BOOLEANs to Ys and Ns}
  69. FUNCTION StrToBool(S : STRING) : BOOLEAN;
  70. {^ If S[1] = 'Y' Then StrToBool := TRUE Else StrToBool := FALSE;}
  71. FUNCTION NoPath(Txt : STRING) : STRING;
  72. {^ Removes blank spaces and trailing backslash from a path name.}
  73. FUNCTION FixPath(Txt : STRING) : STRING;
  74. {^ Adds a trailing backslash to a directory name.}
  75. FUNCTION AllCaps(S : STRING) : STRING;
  76. {^ Conerts a string to upper case}
  77. FUNCTION Lower(S : STRING) : STRING;
  78. {^ Converts a string to lower case}
  79. FUNCTION Proper(S : STRING) : STRING;
  80. {^ Converts a string to a properly capitalized string.}
  81. FUNCTION Dup(Ch : CHAR; Times : BYTE) : STRING;
  82. {^ Dups Ch "times" and returns, good for things like: "---------------" }
  83. FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
  84. {^ Center the text string to fit in between MaxPlace.}
  85. FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
  86. FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
  87. FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
  88. {^ The above functions will strip characters from the beginning and ends of
  89.    a string. "Ch" is the character you wish to strip.}
  90. FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
  91. {^ Converts an integer value to a hexadecimal string.}
  92. FUNCTION HexToInt(HexStr : STRING) : LONGINT;
  93. {^ Converts a hexadecimal string to integer value.}
  94. PROCEDURE HideCursor;
  95. {^ LOCAL ONLY: turns the cursor off}
  96. PROCEDURE ShowCursor;
  97. {^ LOCAL ONLY: turns the cursor on.}
  98. PROCEDURE SetCursorSize(Top,Bot : BYTE);
  99. {^ LOCAL ONLY: Set the size of the cursor. top=top scanline; bot=bottom
  100.    scanline of cursor. Both in the range of 1..8. (7,8)="normal" cursor,
  101.    (1,8)=block cursor....}
  102. PROCEDURE Log(LogLine : STRING);
  103. {^ Use this if you are using activity logging.}
  104. PROCEDURE Terminate(S : STRING);
  105. {^ Halts the program with the Error String "S".}
  106. PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
  107. {^ Use this if you are tracking errors in your program. If BailOut is True,
  108.    then the program will terminate immediately after writing to the log.}
  109. FUNCTION CvtVars(Txt : STRING) : STRING;
  110. {^ Converts a string with embedded global system variables to a translated
  111.    string. You may add/change variables as you see fit.}
  112. FUNCTION DateVariable : STRING;
  113. {^ Returns a nice MM/DD/YY formatted date string.}
  114. FUNCTION TimeVariable : STRING;
  115. {^ Returns a nice ##:##am or ##:##pm formatted time string.}
  116. PROCEDURE SaveScreen;
  117. {^ This saves a text screen to an array in RAM so it can be restored later.}
  118. PROCEDURE RestoreScreen;
  119. {^ This restores the screen you saved with the above command.}
  120. PROCEDURE ShellToDos;
  121. {^ * Just as it says, it shells the program to DOS. This procedure is made
  122.      specifically for door use.}
  123. PROCEDURE DosShell;
  124. {^ * Same as above except this version uses the SaveScreen and
  125.      RestoreScreen procedures. This isn't normally used for doors.}
  126. FUNCTION  LocateFile(FName : STRING) : STRING;
  127. {^ Locates a file in the DOS PATH and returns the full path & file name.}
  128. PROCEDURE _Execute(FName,Params : STRING);
  129. {^ *Runs an external executable/com with no text screen save.}
  130. PROCEDURE Execute(FName,Params : STRING);
  131. {^ *Runs an exteral executable/com with text screen save.}
  132. PROCEDURE _RunBatFile(TheBat : STRING);
  133. {^ *Runs a batch file with no text screen save.}
  134. PROCEDURE RunBatFile(TheBat : STRING);
  135. {^ *Runs a batch file with text screen save.}
  136. {  *NOTE: When these processes run, only a 1.2K footprint of the program
  137.           is left in memory giving you the most RAM for child processes.}
  138. FUNCTION OSstr : STRING;
  139. {^ Returns a string containing the name of the current Operating System.}
  140. PROCEDURE Wait(Seconds : WORD);
  141. {^ Wait a number of seconds. Seconds is not just an approximation like TP's
  142.    Delay procedure. This also does Time Slicing while waiting.}
  143. PROCEDURE SplitUserName;
  144. {^ In some cases you may need to change the DoorSys.UserName....After you do
  145.    that, you will need to refill the UFirst and ULast variables. That's what
  146.    this procedure does for you.}
  147. FUNCTION Translate(InString : STRING) : STRING;
  148. {^ Translates a string of characters of high ASCII to low ASCII.}
  149. FUNCTION AltToNormal(C : CHAR) : CHAR;
  150. {^ Converts ALT keypresses to their normal counterpart.}
  151.  
  152. IMPLEMENTATION
  153.  
  154. USES CRT, EXEC, TDK_VARS, DOORKIT1, DOORKIT3;
  155.  
  156. VAR
  157.   Buffer : ARRAY[1..4000] OF BYTE;
  158.  
  159. {───────────────────────────────────────────────────────────────────────────}
  160. PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR); Assembler;
  161. Asm
  162.   les   di,X
  163.   mov   cx,[Count]
  164.   shr   cx,1
  165.   mov   al,[C]
  166.   mov   ah,[A]
  167.   rep   stosw
  168.   test  [Count],1 {Just in case you give it an odd count.}
  169.   jz    @END
  170.   stosb
  171. @END :
  172. END;
  173. {───────────────────────────────────────────────────────────────────────────}
  174. FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
  175. VAR
  176.   DInfo1  : SEARCHREC;
  177.   DInfo2  : SEARCHREC;
  178.   D1      : DATETIME;
  179.   D2      : DATETIME;
  180.   I1      : LONGINT;
  181.   I2      : LONGINT;
  182. BEGIN
  183.   IsOlder := FALSE;
  184.   FINDFIRST(F1,Archive,DInfo1); I1 := DInfo1.Time; UNPACKTIME(I1,D1);
  185.   FINDFIRST(F2,Archive,DInfo2); I2 := DInfo2.Time; UNPACKTIME(I2,D2);
  186.   IF (D1.Year < D2.Year) THEN IsOlder := TRUE;
  187.   IF (D1.Year = D2.Year) AND (D1.Month < D2.Month) THEN IsOlder := TRUE;
  188.   IF (D1.Year = D2.Year) AND (D1.Month = D2.Month) AND (D1.Day < D2.Day) THEN IsOlder := TRUE;
  189.   IF (D1.Month = D2.Month) AND (D1.Day = D2.Day) AND (D1.Year = D2.Year) THEN BEGIN
  190.     IF (D1.Hour < D2.Hour) THEN IsOlder := TRUE;
  191.     IF (D1.Hour = D2.Hour) AND (D1.Min < D2.Min) THEN IsOlder := TRUE;
  192.   END;
  193. END;
  194. {───────────────────────────────────────────────────────────────────────────}
  195. FUNCTION GetFileName(InString : STRING) : STRING;
  196. VAR
  197.   Work : BYTE;
  198. BEGIN
  199.   InString := StripBoth(InString,' ');
  200.   REPEAT
  201.     Work := POS('\',InString);
  202.     IF Work <> 0 THEN DELETE(InString,1,Work);
  203.   UNTIL Work = 0;
  204.   GetFileName := InString;
  205. END;
  206. {───────────────────────────────────────────────────────────────────────────}
  207. FUNCTION GetFilePath(InString : STRING) : STRING;
  208. VAR
  209.   Loop : BYTE;
  210. BEGIN
  211.   InString := StripBoth(InString,' ');
  212.   IF InString[LENGTH(InString)] = '\' THEN
  213.   BEGIN
  214.     GetFilePath := InString;
  215.     EXIT;
  216.   END;
  217.   Loop := LENGTH(InString);
  218.   REPEAT DEC(Loop) UNTIL ((Loop = 0) OR (InString[Loop] = '\'));
  219.   IF Loop <> 0 THEN DELETE(InString,Loop + 1,LENGTH(InString) - Loop) ELSE InString := '';
  220.   GetFilePath := InString;
  221. END;
  222. {───────────────────────────────────────────────────────────────────────────}
  223. FUNCTION FSize(Fn : PathStr) : LONGINT;
  224. VAR
  225.   F : FILE;
  226. BEGIN
  227.   ASSIGN(F,Fn);
  228.   RESET(F,1);
  229.   IF IORESULT = 0 THEN BEGIN
  230.     FSize := FILESIZE(F);
  231.     CLOSE(F);
  232.   END;
  233. END;
  234. {───────────────────────────────────────────────────────────────────────────}
  235. FUNCTION FErase(Fn : PathStr) : BOOLEAN;
  236. VAR
  237.   F : FILE;
  238. BEGIN
  239.   ASSIGN(F,Fn);
  240.   ERASE(F);
  241.   FErase := IORESULT = 0;
  242. END;
  243. {───────────────────────────────────────────────────────────────────────────}
  244. FUNCTION FExist(Fn : PathStr) : BOOLEAN;
  245. VAR
  246.   DirInfo : SEARCHREC;
  247. BEGIN
  248.   FINDFIRST(Fn,Anyfile - Directory - VolumeID,DirInfo);
  249.   FExist := DOSERROR = 0;
  250. END;
  251. {───────────────────────────────────────────────────────────────────────────}
  252. FUNCTION DExist(Fn : PathStr) : BOOLEAN;
  253. VAR
  254.   OrgDir : PathStr;
  255. BEGIN
  256.   GETDIR(0,OrgDir);
  257.   Fn := AllCaps(NoPath(FExpand(Fn)));
  258.   CHDIR(Fn);
  259.   DExist := IORESULT = 0;
  260.   CHDIR(OrgDir);
  261. END;
  262. {───────────────────────────────────────────────────────────────────────────}
  263. PROCEDURE MakeDir(DirName : STRING);
  264. BEGIN
  265.   DirName := NoPath(AllCaps(DirName));
  266.   IF NOT DExist(DirName) THEN MKDIR(DirName);
  267. END;
  268. {───────────────────────────────────────────────────────────────────────────}
  269. FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
  270. { Return Codes:  0 Successful
  271.                  1 Source and target the same
  272.                  2 Cannot open source
  273.                  3 Unable to create target
  274.                  4 Error during copy }
  275. VAR
  276.   Source,
  277.   Target  : FILE;
  278.   BRead,
  279.   BWrite  : WORD;
  280.   FileBuf : ARRAY[1..2048] OF CHAR;
  281. BEGIN
  282.   SourceFile := StripBoth(SourceFile,' ');
  283.   TargetFile := StripBoth(TargetFile,' ');
  284.   IF SourceFile = TargetFile THEN BEGIN
  285.     CopyFile := 1;
  286.     EXIT;
  287.   END;
  288.   ASSIGN(Source,SourceFile);
  289.   {$I-}RESET(Source,1);{$I+}
  290.   IF IORESULT <> 0 THEN BEGIN
  291.     CopyFile := 2;
  292.     EXIT;
  293.   END;
  294.   ASSIGN(Target,TargetFile);
  295.   {$I-}REWRITE(Target,1);{$I+}
  296.   IF IORESULT <> 0 THEN BEGIN
  297.     CopyFile := 3;
  298.     EXIT;
  299.   END;
  300.   REPEAT
  301.     BLOCKREAD(Source,FileBuf,SIZEOF(FileBuf),BRead);
  302.     BLOCKWRITE(Target,FileBuf,Bread,BWrite);
  303.   UNTIL (BRead = 0) OR (BRead <> BWrite);
  304.   CLOSE(Source);
  305.   CLOSE(Target);
  306.   IF BRead <> BWrite THEN CopyFile := 4 ELSE CopyFile := 0;
  307. END;
  308. {───────────────────────────────────────────────────────────────────────────}
  309. FUNCTION CommaInt(Number : LONGINT) : STRING;
  310. VAR
  311.   NumStr : STRING[15];
  312.   Len    : BYTE;
  313.   I      : BYTE;
  314. BEGIN
  315.   STR(Number,NumStr);
  316.   Len := LENGTH(NumStr);
  317.   I   := Len + 1;
  318.   WHILE (I > 4) AND (I <= Len + 1) DO BEGIN
  319.     DEC(I,3);
  320.     INSERT(',',NumStr,I);
  321.   END;
  322.   CommaInt := NumStr;
  323. END;
  324. {───────────────────────────────────────────────────────────────────────────}
  325. FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  326. BEGIN
  327.   WHILE LENGTH(S) < Len DO S := S + Ch;
  328.   PadRight := S;
  329. END;
  330. {───────────────────────────────────────────────────────────────────────────}
  331. FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
  332. BEGIN
  333.   WHILE LENGTH(S) < Len DO S := Ch + S;
  334.   PadLeft := S;
  335. END;
  336. {───────────────────────────────────────────────────────────────────────────}
  337. FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
  338. VAR
  339.   St : STRING[20];
  340. BEGIN
  341.   STR(N,St);
  342.   WHILE LENGTH(St) < Pad DO INSERT('0',St,1);
  343.   IStr := St;
  344. END;
  345. {───────────────────────────────────────────────────────────────────────────}
  346. FUNCTION IntToStr(N : LONGINT) : STRING;
  347. VAR
  348.   St : STRING;
  349. BEGIN
  350.   STR(N,St);
  351.   IntToStr := St;
  352. END;
  353. {───────────────────────────────────────────────────────────────────────────}
  354. FUNCTION StrToInt(S : STRING) : LONGINT;
  355. VAR
  356.   L : LONGINT;
  357.   U : INTEGER;
  358. BEGIN
  359.   VAL(S,L,U);
  360.   StrToInt := L;
  361. END;
  362. {───────────────────────────────────────────────────────────────────────────}
  363. FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
  364. BEGIN
  365.   IF B THEN BooleanToStr := 'True' ELSE BooleanToStr := 'False';
  366. END;
  367. {───────────────────────────────────────────────────────────────────────────}
  368. FUNCTION BoolToStr(B : BOOLEAN) : STRING;
  369. BEGIN
  370.   IF B THEN BoolToStr := 'Y' ELSE BoolToStr := 'N';
  371. END;
  372. {───────────────────────────────────────────────────────────────────────────}
  373. FUNCTION StrToBool(S : STRING) : BOOLEAN;
  374. BEGIN
  375.   S := StripBoth(S,' ');
  376.   S := AllCaps(S);
  377.   IF POS('Y',S) = 1 THEN StrToBool := TRUE ELSE StrToBool := FALSE;
  378. END;
  379. {───────────────────────────────────────────────────────────────────────────}
  380. FUNCTION NoPath(Txt : STRING) : STRING;
  381. VAR
  382.   Work : BYTE;
  383. BEGIN
  384.   Txt    := StripBoth(Txt,' ');
  385.   Txt    := StripTrail(Txt,'\');
  386.   NoPath := Txt;
  387. END;
  388. {───────────────────────────────────────────────────────────────────────────}
  389. FUNCTION FixPath(Txt : STRING) : STRING;
  390. VAR
  391.   Loop,EndCh : BYTE;
  392. BEGIN
  393.   Txt   := StripBoth(Txt,' ');
  394.   EndCh := LENGTH(Txt);
  395.   FOR Loop := 1 TO LENGTH(Txt) DO Txt[Loop] := UPCASE(Txt[Loop]);
  396.   IF Txt[EndCh] <> '\' THEN Txt := Txt + '\';
  397.   FixPath := Txt;
  398. END;
  399. {───────────────────────────────────────────────────────────────────────────}
  400. FUNCTION AllCaps(S : STRING) : STRING;
  401. VAR
  402.   SLen : BYTE ABSOLUTE S;
  403.   X    : INTEGER;
  404. BEGIN
  405.   FOR X := 1 TO SLen DO S[X] := UPCASE(S[X]);
  406.   AllCaps := S;
  407. END;
  408. {───────────────────────────────────────────────────────────────────────────}
  409. FUNCTION Lower(S : STRING) : STRING;
  410. VAR
  411.   SLen : BYTE ABSOLUTE S;
  412.   I    : INTEGER;
  413. FUNCTION LoCase(Ch : CHAR) : CHAR;
  414. BEGIN
  415.   IF (Ch IN ['A'..'Z']) THEN LoCase := CHR(ORD(Ch) + 32) ELSE LoCase := Ch;
  416. END;
  417. BEGIN
  418.   FOR I := 1 TO SLen DO S[I] := LoCase(S[I]);
  419.   Lower := S;
  420. END;
  421. {───────────────────────────────────────────────────────────────────────────}
  422. FUNCTION Proper(S : STRING) : STRING;
  423. VAR
  424.   SLen : BYTE ABSOLUTE S;
  425.   I    : INTEGER;
  426. BEGIN
  427.   S := Lower(S);
  428.   FOR I := 1 TO SLen DO BEGIN
  429.     IF I = 1 THEN S[1] := UPCASE(S[1])
  430.     ELSE IF S[I - 1] = ' ' THEN S[I] := UPCASE(S[I])
  431.     ELSE IF (ORD(S[I - 1]) IN [32..64]) AND (S[I - 1] <> '''')
  432.     THEN S[I] := UPCASE(S[I]);
  433.   END;
  434.   Proper := S;
  435. END;
  436. {───────────────────────────────────────────────────────────────────────────}
  437. FUNCTION Dup(Ch : CHAR; Times : BYTE) : STRING;
  438. VAR
  439.   Temp : STRING;
  440. BEGIN
  441.   FILLCHAR(Temp[1],Times,Ch);
  442.   Temp[0] := CHAR(Times);
  443.   Dup := Temp;
  444. END;
  445. {───────────────────────────────────────────────────────────────────────────}
  446. FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
  447. CONST
  448.   JustChar : CHAR = ' ';
  449. VAR
  450.   Temp : STRING;
  451.   Num  : BYTE;
  452. BEGIN
  453.   Num    := (MaxPlace DIV 2) - (LENGTH(St) DIV 2);
  454.   Temp   := Dup(JustChar,Num);
  455.   Temp   := Temp + St;
  456.   Temp   := Temp + Dup(JustChar,MaxPlace - Num - LENGTH(St));
  457.   Center := Temp;
  458. END;
  459. {───────────────────────────────────────────────────────────────────────────}
  460. FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
  461. VAR
  462.   TempStr : STRING;
  463. BEGIN
  464.   TempStr := St;
  465.   WHILE ((TempStr[1] = Ch) AND (LENGTH(TempStr) > 0)) DO TempStr := COPY(TempStr,2,LENGTH(TempStr));
  466.   StripLead := TempStr;
  467. END;
  468. {───────────────────────────────────────────────────────────────────────────}
  469. FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
  470. VAR
  471.   TempStr : STRING;
  472.   I       : INTEGER;
  473. BEGIN
  474.   TempStr := St;
  475.   I := LENGTH(St);
  476.   WHILE ((I > 0) AND (St[I] = Ch)) DO I := I - 1;
  477.   TempStr[0] := CHR(I);
  478.   StripTrail := TempStr;
  479. END;
  480. {───────────────────────────────────────────────────────────────────────────}
  481. FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
  482. BEGIN
  483.   StripBoth := StripTrail(StripLead(St,Ch),Ch);
  484. END;
  485. {───────────────────────────────────────────────────────────────────────────}
  486. FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
  487. CONST
  488.   HexId : ARRAY[0..$F] OF CHAR = '0123456789ABCDEF';
  489. VAR
  490.   S : STRING;
  491.   C : BYTE;
  492.   N : ARRAY[1..SIZEOF(LONGINT)] OF BYTE ABSOLUTE Num;
  493. BEGIN
  494.   S := '';
  495.   FOR C := 4 DOWNTO 1 DO S := S + HexId[N[C] SHR 4] + HexId[N[C] AND $F];
  496.   IntToHex := COPY(S,8 - Digits + 1,Digits);
  497. END;
  498. {───────────────────────────────────────────────────────────────────────────}
  499. FUNCTION HexToInt(HexStr : STRING) : LONGINT;
  500. VAR
  501.   I,HexNibble : WORD;
  502.   Temp        : LONGINT;
  503.   Code        : INTEGER;
  504. BEGIN
  505.   Temp   := 0;
  506.   HexStr := AllCaps(HexStr);
  507.   FOR I := LENGTH(HexStr) DOWNTO 1 DO IF NOT (HexStr[I] IN ['0'..'9','A'..'F']) THEN DELETE(HexStr,I,1);
  508.   FOR I := LENGTH(HexStr) DOWNTO 1 DO BEGIN
  509.     IF HexStr[I] IN ['0'..'9'] THEN HexNibble := BYTE(HexStr[I]) - BYTE('0')
  510.                                ELSE HexNibble := BYTE(HexStr[I]) - BYTE('A') + 10;
  511.     INC(Temp,LONGINT(HexNibble) * (1 SHL (4 * (LONGINT(LENGTH(HexStr)) - I))));
  512.   END;
  513.   HexToInt := Temp;
  514. END;
  515. {───────────────────────────────────────────────────────────────────────────}
  516. PROCEDURE HideCursor; Assembler;
  517. Asm
  518.   MOV ax,0100h
  519.   MOV cx,2607h
  520.   INT 10h
  521. END;
  522. {───────────────────────────────────────────────────────────────────────────}
  523. PROCEDURE ShowCursor; Assembler;
  524. Asm
  525.   MOV ax,0100h
  526.   MOV cx,0506h
  527.   INT 10h
  528. END;
  529. {───────────────────────────────────────────────────────────────────────────}
  530. PROCEDURE SetCursorSize(Top,Bot : BYTE); Assembler;
  531. Asm
  532.   MOV ah,01h
  533.   MOV ch,[Top]
  534.   MOV cl,[Bot]
  535.   INT 10h
  536. END;
  537. {───────────────────────────────────────────────────────────────────────────}
  538. PROCEDURE Log(LogLine : STRING);
  539. VAR
  540.   TheLog : Text;
  541. BEGIN
  542.   IF (NOT UseLog) OR (LogFile = '') THEN EXIT;
  543.   LogLine := CvtVars(LogLine);
  544.   ASSIGN(TheLog,LogPath + LogFile);
  545.   IF NOT FExist(LogPath + LogFile) THEN BEGIN
  546.     REWRITE(TheLog);
  547.     CLOSE(TheLog);
  548.   END;
  549.   APPEND(TheLog);
  550.   IF LogLine = 'BEGIN' THEN BEGIN
  551.     WRITELN(TheLog,'───────────────────────────────────────────────────────────────────────────────');
  552.     WRITELN(TheLog,' Activity Log Created By: ' + ProgramName);
  553.     WRITELN(TheLog,'─────────┬─────────────────────────────────────────────────────────────────────');
  554.   END;
  555.   IF (LogLine <> 'BEGIN') AND (LogLine <> 'END') THEN WRITELN(TheLog,' ' + TimeVariable + ' │ ' + LogLine);
  556.   IF (ShowLog) AND (LogLine <> 'BEGIN') AND (LogLine <> 'END') THEN WRITELN(' ' + TimeVariable + ' │ ' + LogLine);
  557.   IF LogLine = 'END' THEN WRITELN(TheLog,'─────────┴─────────────────────────────────────────────────────────────────────');
  558.   CLOSE(TheLog);
  559.   IF (Graphics IN [MAX,RIP]) AND (NOT Local) AND (NOT ShowLog) THEN DVWrite(2,24,15,PadRight(LogLine,' ',78));
  560. END;
  561. {───────────────────────────────────────────────────────────────────────────}
  562. PROCEDURE Terminate(S : STRING);
  563. BEGIN
  564.   TextAttr := 7;
  565.   CLRSCR;
  566.   TextAttr := 12;
  567.   WRITELN(S);
  568.   AlertTones;
  569.   TextAttr := 7;
  570.   DELAY(1000);
  571.   HALT(ErrLevel);
  572. END;
  573. {───────────────────────────────────────────────────────────────────────────}
  574. PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
  575. VAR
  576.   LogFile : Text;
  577. BEGIN
  578.   ASSIGN(LogFile,LogPath + 'ERROR.LOG');
  579.   IF NOT FExist(LogPath + 'ERROR.LOG') THEN BEGIN
  580.     REWRITE(LogFile);
  581.     WRITELN(LogFile,'───────────────────────────────────────────────────────────────────────────────');
  582.     WRITELN(LogFile,' Error Log Created By: ' + ProgramName);
  583.     WRITELN(LogFile,'─────────┬─────────────────────────────────────────────────────────────────────');
  584.     CLOSE(LogFile);
  585.   END;
  586.   APPEND(LogFile);
  587.   WRITELN(LogFile,' ' + TimeVariable + ' │ Error Date: ' + DateVariable);
  588.   WRITELN(LogFile,' ' + TimeVariable + ' │ Error Node: ' + IntToStr(DoorSys.Node));
  589.   WRITELN(LogFile,' ' + TimeVariable + ' │ ' + LogLine);
  590.   IF BailOut THEN WRITELN(LogFile,' ' + TimeVariable + ' │ Exiting At ErrorLevel ' + IntToStr(ErrLevel));
  591.   CLOSE(LogFile);
  592.   ErrLevel := ELevel;
  593.   IF BailOut THEN Terminate(LogLine);
  594. END;
  595. {───────────────────────────────────────────────────────────────────────────}
  596. FUNCTION CvtVars(Txt : STRING) : STRING;
  597. VAR
  598.   Loop   : BYTE;
  599.   Count  : BYTE;
  600.   LStart : BOOLEAN;
  601.   LPad   : BOOLEAN;
  602.   RStart : BOOLEAN;
  603.   RPad   : BOOLEAN;
  604.   Cvt    : BOOLEAN;
  605.   Parm   : STRING;
  606.   Temp   : STRING;
  607. BEGIN
  608.   Cvt    := FALSE;
  609.   LStart := FALSE;
  610.   RStart := FALSE;
  611.   LPad   := FALSE;
  612.   RPad   := FALSE;
  613.   Count  := 0;
  614.   Parm   := '';
  615.   Temp   := '';
  616.   FOR Loop := 1 TO LENGTH(Txt) DO BEGIN
  617.     IF (LStart) AND (Txt[Loop] <> '_') THEN BEGIN
  618.       LStart := FALSE;
  619.       RStart := TRUE;
  620.     END;
  621.     IF Txt[Loop] = '{' THEN BEGIN
  622.       Cvt    := TRUE;
  623.       LStart := TRUE;
  624.     END;
  625.     IF NOT Cvt THEN Parm := Parm + Txt[Loop];
  626.     IF (LStart) AND (Txt[Loop] = '_') THEN LPad := TRUE;
  627.     IF (RStart) AND (Txt[Loop] = '_') THEN RPad := TRUE;
  628.     IF (Cvt) THEN BEGIN
  629.       INC(Count);
  630.       IF ((LStart) AND (Txt[Loop] <> '_')) OR ((RStart) AND (Txt[Loop] <> '_')) THEN Temp := Temp + Txt[Loop];
  631.     END;
  632.     IF Txt[Loop] = '}' THEN BEGIN
  633.       IF Temp = '{TIME}'     THEN Temp := TimeVariable;
  634.       IF Temp = '{DATE}'     THEN Temp := DateVariable;
  635.       IF Temp = '{NODE}'     THEN Temp := IntToStr(DoorSys.Node);
  636.       IF Temp = '{BAUD}'     THEN Temp := IntToStr(DoorSys.BaudRate);
  637.       IF Temp = '{EVENT}'    THEN Temp := IntToStr(DoorSys.Event);
  638.       IF Temp = '{MINS}'     THEN Temp := IntToStr(DoorSys.SecondsLeft DIV 60);
  639.       IF Temp = '{EVENT}'    THEN Temp := IntToStr(DoorSys.Event);
  640.       IF Temp = '{PORT}'     THEN Temp := IntToStr(DoorSys.Comport);
  641.       IF Temp = '{SEC}'      THEN Temp := IntToStr(DoorSys.Access);
  642.       IF Temp = '{BBS}'      THEN Temp := Ctl.BBSname;
  643.       IF Temp = '{USER}'     THEN Temp := DoorSys.UserName;
  644.       IF Temp = '{USER#}'    THEN Temp := IntToStr(DoorSys.UserNumber);
  645.       IF Temp = '{SYSOP}'    THEN Temp := Ctl.SFirst + ' ' + Ctl.SLast;
  646.       IF Temp = '{UFIRST}'   THEN Temp := UFirst;
  647.       IF Temp = '{ULAST}'    THEN Temp := ULast;
  648.       IF Temp = '{SFIRST}'   THEN Temp := Ctl.SFirst;
  649.       IF Temp = '{SLAST}'    THEN Temp := Ctl.SLast;
  650.       IF Temp = '{PROG}'     THEN Temp := ProgramName;
  651.       IF Temp = '{ADDR}'     THEN Temp := Ctl.HexAddr;
  652.       IF Temp = '{IRQ}'      THEN Temp := IntToStr(Ctl.IRQ);
  653.       IF Temp = '{SYSSEC}'   THEN Temp := IntToStr(Ctl.SysSec);
  654.       IF Temp = '{SERIAL}'   THEN Temp := Ctl.SerialNumber;
  655.       IF Temp = '{INSERT1}'  THEN Temp := Insert1;
  656.       IF Temp = '{INSERT2}'  THEN Temp := Insert2;
  657.       IF Temp = '{INSERT3}'  THEN Temp := Insert3;
  658.       IF Temp = '{INSERT4}'  THEN Temp := Insert4;
  659.       IF Temp = '{INSERT5}'  THEN Temp := Insert5;
  660.       IF LPad THEN Temp := PadLeft(Temp,' ',Count);
  661.       IF RPad THEN Temp := PadRight(Temp,' ',Count);
  662.       Parm   := Parm + Temp;
  663.       Temp   := '';
  664.       Cvt    := FALSE;
  665.       LStart := FALSE;
  666.       RStart := FALSE;
  667.       LPad   := FALSE;
  668.       RPad   := FALSE;
  669.       Count  := 0;
  670.     END;
  671.   END;
  672.   IF (Cvt) AND (Loop = LENGTH(Txt)) THEN Parm := Parm + Temp;
  673.   CvtVars := Parm;
  674. END;
  675. {───────────────────────────────────────────────────────────────────────────}
  676. FUNCTION DateVariable : STRING;
  677. VAR
  678.   Mo,
  679.   Da,Yr      : STRING[4];
  680.   Year,Month,
  681.   Day,Dow    : WORD;
  682. BEGIN
  683.   GETDATE(Year,Month,Day,Dow);
  684.   STR(Year,Yr); DELETE(Yr,1,2);
  685.   STR(Month,Mo);
  686.   IF Month < 10 THEN Mo := '0' + Mo;
  687.   STR(Day,Da);
  688.   IF Day < 10   THEN Da := '0' + Da;
  689.   DateVariable := Mo + '/' + Da + '/' + Yr;
  690. END;
  691. {───────────────────────────────────────────────────────────────────────────}
  692. FUNCTION TimeVariable : STRING;
  693. VAR
  694.   TStr,
  695.   Hr,Mn      : STRING[2];
  696.   Hour,Min,
  697.   Sec,Sec100 : WORD;
  698. BEGIN
  699.   GETTIME(Hour,Min,Sec,Sec100);
  700.   IF Hour < 12 THEN TStr := 'am' ELSE TStr := 'pm';
  701.   IF Hour = 0  THEN Hour := 12;
  702.   IF Hour > 12 THEN Hour := Hour - 12;
  703.   STR(Hour,Hr);
  704.   STR(Min,Mn);
  705.   IF Min < 10  THEN Mn := '0' + Mn;
  706.   IF Min = 0   THEN Mn := '00';
  707.   IF Hour < 10 THEN Hr := ' ' + Hr;
  708.   TimeVariable := Hr + ':' + Mn + TStr;
  709. END;
  710. {───────────────────────────────────────────────────────────────────────────}
  711. PROCEDURE SaveScreen;
  712. BEGIN
  713.   MOVE(Mem[$B800 : 0000],Buffer,4000);
  714. END;
  715. {───────────────────────────────────────────────────────────────────────────}
  716. PROCEDURE RestoreScreen;
  717. BEGIN
  718.   MOVE(Buffer,Mem[$B800 : 0000],4000);
  719. END;
  720. {───────────────────────────────────────────────────────────────────────────}
  721. PROCEDURE ShellToDos;
  722. VAR
  723.   TheDir : STRING;
  724. BEGIN
  725.   sWriteln(''); sWriteln('');
  726.   IceText('The SysOp Has Shelled To DOS, Please Wait....',FALSE);
  727.   GETDIR(0,TheDir);
  728.   WINDOW(1,1,80,25);
  729.   CLRSCR;
  730.   ShowCursor;
  731.   DeInitComport;
  732.   PutEnv('PROMPT=Type: EXIT and press <ENTER> to return to ' + ProgramName + '!$_$p$g');
  733.   Do_Exec(GetEnv('COMSPEC'),' /C ' + GetEnv('COMSPEC'),Use_All,$ffff,TRUE);
  734.   InitComport;
  735.   CLRSCR;
  736.   WINDOW(1,1,80,24);
  737.   ShowStatusBar;
  738.   CHDIR(TheDir);
  739.   sClrScr;
  740.   IceText('The SysOp Has Returned From DOS....',TRUE);
  741.   sWriteln('');
  742.   IceText('Press Any Key To Redraw Screen',FALSE);
  743. END;
  744. {───────────────────────────────────────────────────────────────────────────}
  745. PROCEDURE DosShell;
  746. VAR
  747.   TheDir : STRING;
  748. BEGIN
  749.   SaveScreen;
  750.   GETDIR(0,TheDir);
  751.   WINDOW(1,1,80,25);
  752.   CLRSCR;
  753.   ShowCursor;
  754.   PutEnv('PROMPT=Type: EXIT and press <ENTER> to return to ' + ProgramName + '!$_$p$g');
  755.   Do_Exec(GetEnv('COMSPEC'),' /C ' + GetEnv('COMSPEC'),Use_All,$ffff,TRUE);
  756.   CHDIR(TheDir);
  757.   RestoreScreen;
  758. END;
  759. {───────────────────────────────────────────────────────────────────────────}
  760. FUNCTION LocateFile(FName : STRING) : STRING;
  761. VAR
  762.   F : STRING;
  763. BEGIN
  764.   IF NOT FExist(FName) THEN BEGIN
  765.     F := FSearch(FName,GetEnv('PATH'));
  766.     LocateFile := FExpand(F);
  767.     EXIT;
  768.   END ELSE LocateFile := FName;
  769. END;
  770. {───────────────────────────────────────────────────────────────────────────}
  771. PROCEDURE _Execute(FName,Params : STRING);
  772. VAR
  773.   TheDir : STRING;
  774. BEGIN
  775.   FName := LocateFile(FName);
  776.   IF FName = '' THEN EXIT;
  777.   GETDIR(0,TheDir);
  778.   Do_Exec(FName,Params,Use_All,$ffff,TRUE);
  779.   CHDIR(TheDir);
  780.   DoorSys.IdleCount := 0;
  781.   UpdateTime;
  782. END;
  783. {───────────────────────────────────────────────────────────────────────────}
  784. PROCEDURE Execute(FName,Params : STRING);
  785. VAR
  786.   TheDir : STRING;
  787. BEGIN
  788.   FName := LocateFile(FName);
  789.   IF FName = '' THEN EXIT;
  790.   GETDIR(0,TheDir);
  791.   SaveScreen;
  792.   DeInitComport;
  793.   Do_Exec(FName,Params,Use_All,$ffff,TRUE);
  794.   InitComport;
  795.   RestoreScreen;
  796.   ShowStatusBar;
  797.   CHDIR(TheDir);
  798.   DoorSys.IdleCount := 0;
  799.   UpdateTime;
  800. END;
  801. {───────────────────────────────────────────────────────────────────────────}
  802. PROCEDURE _RunBatFile(TheBat : STRING);
  803. VAR
  804.   TheDir : STRING;
  805. BEGIN
  806.   GETDIR(0,TheDir);
  807.   Do_Exec(GetEnv('COMSPEC'),' /C ' + TheBat,Use_All,$ffff,TRUE);
  808.   CHDIR(TheDir);
  809.   DoorSys.IdleCount := 0;
  810.   UpdateTime;
  811. END;
  812. {───────────────────────────────────────────────────────────────────────────}
  813. PROCEDURE RunBatFile(TheBat : STRING);
  814. VAR
  815.   TheDir : STRING;
  816. BEGIN
  817.   GETDIR(0,TheDir);
  818.   SaveScreen;
  819.   DeInitComport;
  820.   Do_Exec(GetEnv('COMSPEC'),' /C ' + TheBat,Use_All,$ffff,TRUE);
  821.   InitComport;
  822.   RestoreScreen;
  823.   ShowStatusBar;
  824.   CHDIR(TheDir);
  825.   DoorSys.IdleCount := 0;
  826.   UpdateTime;
  827. END;
  828. {──────────────────────────────────────────────────────────────────────────}
  829. FUNCTION OSstr : STRING;
  830. BEGIN
  831.   CASE OS OF
  832.     _DOS : OsStr := 'DOS / No Multi-Tasker';
  833.     DV   : OsStr := 'DesqView';
  834.     WIN  : OsStr := 'MS Windows';
  835.     OS2  : OsStr := 'IBM OS/2';
  836.   END;
  837. END;
  838. {───────────────────────────────────────────────────────────────────────────}
  839. PROCEDURE Wait;
  840. VAR
  841.   U,Chs,Shs,CurSec,StartSec : WORD;
  842. BEGIN
  843.   GETTIME(U,U,StartSec,Shs);
  844.   WHILE Seconds > 0 DO BEGIN
  845.     REPEAT
  846.       GETTIME(U,U,CurSec,Chs);
  847.       TimeSlice;
  848.       TimeSlice;
  849.     UNTIL (CurSec <> StartSec);
  850.     StartSec := CurSec;
  851.     DEC(Seconds);
  852.   END;
  853. END;
  854. {───────────────────────────────────────────────────────────────────────────}
  855. PROCEDURE SplitUserName;
  856. VAR
  857.   Loop  : BYTE;
  858.   FDone,
  859.   LDone : BOOLEAN;
  860. BEGIN
  861.   UFirst := ''; ULast := ''; FDone := FALSE; LDone := TRUE;
  862.   FOR Loop := 1 TO LENGTH(DoorSys.UserName) DO BEGIN
  863.     IF DoorSys.UserName[Loop - 1] = ' ' THEN BEGIN
  864.       FDone := TRUE;
  865.       LDone := FALSE;
  866.     END;
  867.     IF (NOT FDone) AND (DoorSys.UserName[Loop] <> ' ') THEN UFirst := UFirst + DoorSys.UserName[Loop];
  868.     IF NOT LDone THEN ULast := ULast + DoorSys.UserName[Loop];
  869.   END;
  870. END;
  871. {───────────────────────────────────────────────────────────────────────────}
  872. FUNCTION NewChar(Ch : CHAR) : CHAR;
  873. BEGIN
  874.   CASE Ch OF
  875.     #0         : Ch := ' ';
  876.     #1..#7     : Ch := '@';
  877.     #8         : Ch := '#';
  878.     #9         : Ch := '*';
  879.     #10        : Ch := '#';
  880.     #11..#15   : Ch := '*';
  881.     #16        : Ch := '>';
  882.     #17        : Ch := '<';
  883.     #18..#21   : Ch := '!';
  884.     #22        : Ch := '*';
  885.     #23..#25   : Ch := '!';
  886.     #26        : Ch := '>';
  887.     #27        : Ch := '<';
  888.     #28        : Ch := '+';
  889.     #29..#31   : Ch := '^';
  890.     #128       : Ch := 'C';
  891.     #129       : Ch := 'u';
  892.     #130       : Ch := 'e';
  893.     #131..#134 : Ch := 'a';
  894.     #135       : Ch := 'c';
  895.     #136..#138 : Ch := 'e';
  896.     #139..#141 : Ch := 'i';
  897.     #142..#143 : Ch := 'A';
  898.     #144       : Ch := 'E';
  899.     #145       : Ch := 'a';
  900.     #146       : Ch := 'A';
  901.     #147..#149 : Ch := 'o';
  902.     #150..#151 : Ch := 'u';
  903.     #152       : Ch := 'y';
  904.     #153       : Ch := 'O';
  905.     #154       : Ch := 'U';
  906.     #155       : Ch := 'c';
  907.     #156       : Ch := 'L';
  908.     #157       : Ch := 'Y';
  909.     #158       : Ch := 'P';
  910.     #159       : Ch := 'f';
  911.     #160       : Ch := 'a';
  912.     #161       : Ch := 'i';
  913.     #162       : Ch := 'o';
  914.     #163       : Ch := 'u';
  915.     #164       : Ch := 'n';
  916.     #165       : Ch := 'N';
  917.     #166       : Ch := 'a';
  918.     #167       : Ch := 'o';
  919.     #168       : Ch := '?';
  920.     #169..#170 : Ch := '+';
  921.     #171       : Ch := '2';
  922.     #172       : Ch := '4';
  923.     #173       : Ch := '!';
  924.     #174       : Ch := '<';
  925.     #175       : Ch := '>';
  926.     #176..#178 : Ch := '#';
  927.     #179..#182 : Ch := '|';
  928.     #183..#184 : Ch := '+';
  929.     #185..#186 : Ch := '|';
  930.     #187..#192 : Ch := '+';
  931.     #193..#194 : Ch := '-';
  932.     #195       : Ch := '|';
  933.     #196       : Ch := '-';
  934.     #197       : Ch := '+';
  935.     #198..#199 : Ch := '|';
  936.     #200..#201 : Ch := '+';
  937.     #202..#203 : Ch := '-';
  938.     #204       : Ch := '|';
  939.     #205       : Ch := '-';
  940.     #206       : Ch := '+';
  941.     #207..#210 : Ch := '-';
  942.     #211..#218 : Ch := '+';
  943.     #219..#223 : Ch := '#';
  944.     #224       : Ch := 'a';
  945.     #225       : Ch := 'B';
  946.     #226       : Ch := 'T';
  947.     #227       : Ch := 'n';
  948.     #228       : Ch := 'E';
  949.     #229       : Ch := 'o';
  950.     #230       : Ch := 'u';
  951.     #231       : Ch := 't';
  952.     #232       : Ch := 'o';
  953.     #233..#237 : Ch := 'O';
  954.     #238       : Ch := 'E';
  955.     #239       : Ch := 'N';
  956.     #240       : Ch := '=';
  957.     #241       : Ch := '+';
  958.     #242       : Ch := '>';
  959.     #243       : Ch := '<';
  960.     #244..#245 : Ch := '!';
  961.     #246       : Ch := '/';
  962.     #247       : Ch := '~';
  963.     #248..#250 : Ch := '.';
  964.     #251       : Ch := '/';
  965.     #252       : Ch := 'n';
  966.     #253       : Ch := '2';
  967.     #254       : Ch := '*';
  968.     #255       : Ch := ' ';
  969.   END;
  970.   NewChar := Ch;
  971. END;
  972. {───────────────────────────────────────────────────────────────────────────}
  973. FUNCTION Translate(InString : STRING) : STRING;
  974. VAR
  975.   Loop : BYTE;
  976.   Ch   : CHAR;
  977.   Temp : STRING;
  978. BEGIN
  979.   Temp := '';
  980.   FOR Loop := 1 TO LENGTH(InString) DO BEGIN
  981.     Ch := InString[Loop];
  982.     IF (Ch > #127) OR (Ch < #32) THEN Ch := NewChar(Ch);
  983.     Temp := Temp + Ch;
  984.   END;
  985.   Translate := Temp;
  986. END;
  987. {───────────────────────────────────────────────────────────────────────────}
  988. FUNCTION AltToNormal(C : CHAR) : CHAR;
  989. BEGIN
  990.   CASE C OF
  991.     #30 :  AltToNormal := 'A';
  992.     #48 :  AltToNormal := 'B';
  993.     #46 :  AltToNormal := 'C';
  994.     #32 :  AltToNormal := 'D';
  995.     #18 :  AltToNormal := 'E';
  996.     #33 :  AltToNormal := 'F';
  997.     #34 :  AltToNormal := 'G';
  998.     #35 :  AltToNormal := 'H';
  999.     #23 :  AltToNormal := 'I';
  1000.     #36 :  AltToNormal := 'J';
  1001.     #37 :  AltToNormal := 'K';
  1002.     #38 :  AltToNormal := 'L';
  1003.     #50 :  AltToNormal := 'M';
  1004.     #49 :  AltToNormal := 'N';
  1005.     #24 :  AltToNormal := 'O';
  1006.     #25 :  AltToNormal := 'P';
  1007.     #16 :  AltToNormal := 'Q';
  1008.     #17 :  AltToNormal := 'R';
  1009.     #31 :  AltToNormal := 'S';
  1010.     #20 :  AltToNormal := 'T';
  1011.     #22 :  AltToNormal := 'U';
  1012.     #47 :  AltToNormal := 'V';
  1013.     #17 :  AltToNormal := 'W';
  1014.     #45 :  AltToNormal := 'X';
  1015.     #21 :  AltToNormal := 'Y';
  1016.     #44 :  AltToNormal := 'Z';
  1017.     #120 : AltToNormal := '1';
  1018.     #121 : AltToNormal := '2';
  1019.     #122 : AltToNormal := '3';
  1020.     #123 : AltToNormal := '4';
  1021.     #124 : AltToNormal := '5';
  1022.     #125 : AltToNormal := '6';
  1023.     #126 : AltToNormal := '7';
  1024.     #127 : AltToNormal := '8';
  1025.     #128 : AltToNormal := '9';
  1026.     #129 : AltToNormal := '0';
  1027.     ELSE  AltToNormal := C;
  1028.   END;
  1029. END;
  1030. {──────────────────────────────────────────────────────────────────────────}
  1031. END.
  1032.